home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / SKIPTP.f < prev    next >
Text File  |  1992-07-31  |  3KB  |  88 lines
  1.       SUBROUTINE SKIPTP(ITYPE,STRING,ICC1,ICC2,HOLFLG,KPOS,ILEV)
  2. *-----------------------------------------------------------------------
  3. * positions on the last character of a string of the requested type 
  4. * input 
  5. * ITYPE      1 = numeric
  6. *            2 = alpha  
  7. *            3 = alpha-numeric  
  8. *            4 = special
  9. *            5 = FORTRAN-name   
  10. *            6 = expression ( no [,] at level 0 )   
  11. * STRING     string 
  12. * ICC1       first ch, in string
  13. * ICC2       last   -    -  -   
  14. * HOLFLG     if TRUE, hollerith included
  15. * output
  16. * KPOS       position of last ch. of given type, if ICC1 is of that 
  17. *            type, otherwise = 0
  18. * ILEV       level (including KPOS) relative to input level 0   
  19. *-----------------------------------------------------------------------
  20.       LOGICAL HOLFLG
  21.       CHARACTER STRING*(*),STEMP*1  
  22.       include 'CONVEX.h' 
  23.       ILEV=0
  24.       KPOS=0
  25.       NCNT=0
  26.       ISSTR=0   
  27.       ILBASE=-1 
  28.       JC=ICC1-1 
  29.    10 JC=JC+1   
  30.       IF (JC.GT.ICC2) GOTO 999  
  31.       STEMP=STRING(JC:JC)   
  32. *--- skip blanks outside strings
  33.       IF (STEMP.EQ.' '.AND.ISSTR.EQ.0) GOTO 10  
  34.       IF(STEMP.EQ.'{')  THEN
  35. *--- start of character string  
  36.          ISSTR=1
  37.          IF (.NOT.HOLFLG) THEN  
  38.             ISSTR=0 
  39.             I=INDEX(STRING(JC:ICC2),'}')
  40.             IF (I.EQ.0) GOTO 999
  41.             JC=I+JC-2   
  42.          ENDIF  
  43.          GOTO 10
  44.       ELSEIF(STEMP.EQ.'}')  THEN
  45.          ISSTR=0
  46.          IF(ITYPE.EQ.6)  THEN   
  47.             KPOS=JC 
  48.          ELSE   
  49.             GOTO 10 
  50.          ENDIF  
  51.       ELSEIF(ITYPE.EQ.1)  THEN  
  52.          IF (NUMCH(STEMP)) KPOS=JC  
  53.       ELSEIF(ITYPE.EQ.2)  THEN  
  54.          IF (ALPHCH(STEMP)) KPOS=JC 
  55.       ELSEIF(ITYPE.EQ.3)  THEN  
  56.          IF (ANUMCH(STEMP)) KPOS=JC 
  57.       ELSEIF(ITYPE.EQ.4)  THEN  
  58.          IF (SPECCH(STEMP))  THEN   
  59.             KPOS=JC 
  60.             IF (STEMP.EQ.'(')  THEN 
  61.                ILEV=ILEV+1  
  62.             ELSEIF (STEMP.EQ.')')  THEN 
  63.                ILEV=ILEV-1  
  64.             ENDIF   
  65.          ENDIF  
  66.       ELSEIF(ITYPE.EQ.5)  THEN  
  67.          IF (NCNT.EQ.0)  THEN   
  68.             IF (ALPHCH(STEMP))  THEN
  69.                KPOS=JC  
  70.                NCNT=NCNT+1  
  71.             ENDIF   
  72.          ELSEIF (ANUMCH(STEMP))  THEN   
  73.             KPOS=JC 
  74.          ENDIF  
  75.       ELSEIF(ITYPE.EQ.6)  THEN  
  76.          IF (KPOS.EQ.0.AND..NOT.(ANUMCH(STEMP).OR.STEMP.EQ.'('.OR.STEMP.
  77.      +   EQ.'+'.OR.STEMP.EQ.'-'.OR.STEMP.EQ.''''))GOTO 999  
  78.          IF (STEMP.EQ.'(')  THEN
  79.             ILEV=ILEV+1 
  80.          ELSEIF (ILBASE.LT.0)  THEN 
  81.             ILBASE=ILEV 
  82.          ENDIF  
  83.          IF (STEMP.EQ.')')  ILEV=ILEV-1 
  84.          IF ((STEMP.NE.','.OR.ILEV-ILBASE.GT.0).AND.ILEV.GE.0) KPOS=JC  
  85.       ENDIF 
  86.       IF (KPOS.EQ.JC) GOTO 10   
  87.   999 END   
  88.